home *** CD-ROM | disk | FTP | other *** search
/ Chip 2004 April / CMCD0404.ISO / Software / Shareware / Programare / sharp / wwwSharp_setup.exe / {app} / Examples / RssPublisher / Source / RssPublisher.vbs < prev    next >
Text File  |  2004-02-04  |  19KB  |  668 lines

  1. Option Explicit
  2.  
  3. Dim BookmarkType
  4. Dim rsArticles
  5. Dim CurrentBookmark
  6.  
  7. BookmarkType = vbEmpty
  8. rsArticles = Null
  9. CurrentBookmark = Null
  10.  
  11. Function VarAsType(Value, ValueType)
  12.     Select Case ValueType
  13.         Case vbInteger VarAsType = CInt(Value)
  14.         Case vbLong VarAsType = CLng(Value)
  15.         Case vbSingle VarAsType = CSng(Value)
  16.         Case vbDouble VarAsType = CDbl(Value)
  17.         Case vbCurrency VarAsType = CCur(Value)
  18.         Case vbDate VarAsType = CDate(Value)
  19.         Case vbString VarAsType = CStr(Value)
  20.         Case vbBoolean VarAsType = CBool(Value)
  21.         Case vbVariant VarAsType = Value 'Leave as is
  22.         Case vbByte VarAsType = CByte(Value)
  23.         Case Else Err.Raise 5, "Convertion", "Convertion failed"
  24.     End Select
  25. End Function
  26.  
  27. Sub CleanupArticle()
  28.     document.all.inpArticleTitle.innerText = ""
  29.     document.all.inpArticleDescription.innerText = ""
  30.     document.all.inpArticleURL.innerText = ""
  31.     document.all.inpArticleDate.innerText = ""
  32.     document.all.inpArticleCategory.innerText = ""
  33.     document.all.inpArticleKeywords.innerText = ""
  34.     document.all.inpArticleAuthorNames.innerText = ""
  35.     document.all.inpArticleAuthorEmails.innerText = ""
  36. End Sub
  37.  
  38. Sub CleanupArticles()
  39.     CleanupArticle()
  40.     document.all.tblArticleList.outerHTML = "<TABLE id=""tblArticleList"" cols=""1"" border=""0""></TABLE>"
  41. End Sub
  42.  
  43. Sub CleanupSite()
  44.     document.all.inpSiteTitle.innerText = ""
  45.     document.all.inpSiteDescription.innerText = ""
  46.     document.all.inpSiteURL.innerText = ""
  47.     document.all.inpSiteDetails.innerText = ""
  48.     document.all.inpSiteImageURL.innerText = ""
  49.     document.all.inpSiteFurtherReading.innerText = ""
  50.     document.all.inpSiteAuthorNames.innerText = ""
  51.     document.all.inpSiteAuthorEmails.innerText = ""
  52. End Sub
  53.  
  54. Sub CleanupAll()
  55.     CleanupSite()
  56.     CleanupArticles()
  57. End Sub
  58.  
  59. Sub SetInputText(RootNode, inputControl, NodePath)
  60.     Dim Node
  61.     Set Node = RootNode.selectSingleNode(NodePath)
  62.     If IsEmpty(Node) or IsNull(Node) or (Node is Nothing) Then Exit Sub
  63.     inputControl.innerText = Node.text
  64. End Sub
  65.  
  66. ' Retrieve authors name and email from dc:creator node
  67. Sub FindAuthors(RootNode, ByRef Authors, ByRef Emails)
  68.     Dim Nodes, Node, i, AuthorText, Pos, Author, Email
  69.     Authors = ""
  70.     Emails = ""
  71.  
  72.     Set Nodes = RootNode.selectNodes("./dc:creator")
  73.     For i = 0 To Nodes.length-1
  74.         Set Node = Nodes.item(i)
  75.         AuthorText = Node.text
  76.  
  77.         Pos = InStr(1, AuthorText, "(mailto:", 1)
  78.         If Pos > 0 Then
  79.             Author = Trim(Mid(AuthorText, 1, Pos-1))
  80.             Email = Trim(Mid(AuthorText, Pos + Len("(mailto:")))
  81.             If (Len(Email) > 0) and (Mid(Email, Len(Email), 1) = ")") Then
  82.                 Email = Mid(Email, 1, Len(Email) - 1)
  83.             End If
  84.         Else
  85.             Author = AuthorText
  86.             Email = ""
  87.         End If
  88.         
  89.         If Len(Authors) > 0 Then Authors = Authors & "|"
  90.         Authors = Authors & Author
  91.         if Len(Emails) > 0 Then Emails = Emails & "|"
  92.         Emails = Emails & Email
  93.     Next
  94. End Sub
  95.  
  96. Sub SetAuthors(RootNode)
  97.     Dim Authors, Emails
  98.     FindAuthors RootNode, Authors, Emails
  99.     
  100.        document.all.inpSiteAuthorNames.innerText = Authors
  101.        document.all.inpSiteAuthorEmails.innerText = Emails
  102. End Sub
  103.  
  104. Sub OpenChannel(Channel)
  105.     SetInputText Channel, document.all.inpSiteTitle, "./title"
  106.     SetInputText Channel, document.all.inpSiteDescription, "./description"
  107.     SetInputText Channel, document.all.inpSiteURL, "./link"
  108.     SetInputText Channel, document.all.inpSiteDetails, "./dc:publisher"
  109.     SetInputText Channel, document.all.inpSiteImageURL, "./image/@rdf:resource"
  110.     SetInputText Channel, document.all.inpSiteFurtherReading, "./fr:url"
  111.     SetAuthors Channel
  112. End Sub
  113.  
  114. ' Create new recordset
  115. Sub CreateRecordset()
  116.     Dim rs
  117.     Set rs = CreateObject("ADODB.Recordset")
  118.     
  119.     If Err.Number <> 0 Then
  120.         MsgBox("Create: " & Err.Description)
  121.         Exit Sub
  122.     End If
  123.     
  124.     rs.Fields.Append "Title", 200, 255, &H64    'adVarChar, adFldUpdatable or adFldIsNullable or adFldMayBeNull
  125.     rs.Fields.Append "Description", 201, 4000, &HE4    'adLongVarChar, adFldUpdatable or adFldIsNullable or adFldMayBeNull or adFldLong
  126.     rs.Fields.Append "URL", 200, 255, &H64
  127.     rs.Fields.Append "Date", 200, 80, &H64
  128.     rs.Fields.Append "Category", 200, 50, &H64
  129.     rs.Fields.Append "Keywords", 200, 255, &H64
  130.     rs.Fields.Append "Author", 200, 255, &H64
  131.     rs.Fields.Append "Email", 200, 255, &H64
  132.  
  133.     If Err.Number <> 0 Then
  134.         MsgBox("Add fields: " & Err.Description)
  135.         Exit Sub
  136.     End If
  137.  
  138.     rs.Open
  139.     If Err.Number <> 0 Then
  140.         MsgBox("Open: " & Err.Description)
  141.         Exit Sub
  142.     End If
  143.     
  144.     Set rsArticles = rs
  145. End Sub
  146.  
  147. Sub SetColumnValue(RootNode, ColumnName, NodePath)
  148.     On Error Resume Next
  149.     Dim Node
  150.     Set Node = RootNode.selectSingleNode(NodePath)
  151.     If IsEmpty(Node) or IsNull(Node) or (Node Is Nothing) Then Exit Sub
  152.     rsArticles(ColumnName) = CStr(Node.text)
  153. End Sub
  154.  
  155. Sub OpenItem(Item)
  156.     On Error Resume Next
  157.     Dim Authors, Emails
  158.     Authors = ""
  159.     Emails = ""
  160.     rsArticles.AddNew()
  161.     SetColumnValue Item, "Title", "./title"
  162.     SetColumnValue Item, "Description", "./description"
  163.     SetColumnValue Item, "URL", "./link"
  164.     SetColumnValue Item, "Date", "./dc:date"
  165.     SetColumnValue Item, "Category", "./pa:category"
  166.     SetColumnValue Item, "Keywords", "./pa:keywords"
  167.     FindAuthors Item, Authors, Emails
  168.     rsArticles("Author") = Authors
  169.     rsArticles("Email") = Emails
  170.     rsArticles.Update()
  171. End Sub
  172.  
  173. Sub OnBtnOpenRSSClick()
  174.     CleanupAll()
  175.     rsArticles = Null
  176.  
  177.     Dim xmlDoc, Channel, Items, Item, Node, i
  178.     Set xmlDoc = CreateObject("MsXml2.DOMDocument")
  179.  
  180.      cDialog.Filter = "RSS files (*.xml)|*.xml|All files (*.*)|*.*"
  181.      cDialog.FileName = ""
  182.     cDialog.CancelError = True
  183.     On Error Resume Next
  184.     cDialog.ShowOpen()
  185.     If Err.Number <> 0 Then Exit Sub
  186.  
  187.     On Error Goto 0
  188.     xmlDoc.async = False
  189.     xmlDoc.validateOnParse = True
  190.     xmlDoc.Load(cDialog.FileName)
  191.     If xmlDoc.parseError.ErrorCode <> 0 Then
  192.         Err.Raise 5, "RSS Reader", xmlDoc.parseError.reason
  193.     End If
  194.     
  195.     'Process only first channel, ignore others if any
  196.     Set Channel = xmlDoc.documentElement.selectSingleNode("./channel")
  197.     If IsEmpty(Channel) or IsNull(Channel) or (Channel is Nothing) Then
  198.         Err.Raise 5, "RSS Reader", "RSS File is invalid"
  199.     End If
  200.     OpenChannel(Channel)
  201.  
  202.     CreateRecordset()
  203.  
  204.     Set Items = xmlDoc.documentElement.selectNodes("./item")
  205.     For i = 0 to (Items.length - 1)
  206.         Set Item = Items.item(i)
  207.         OpenItem(Item)
  208.     Next
  209.     
  210.     FillArticleList()
  211. End Sub
  212.  
  213. Sub OnBtnImportADOClick()
  214.     Dim locator, conn
  215.     Set locator = CreateObject("DataLinks")
  216.     Set conn = locator.PromptNew()
  217.     If (IsEmpty(conn) or IsNull(conn) or (conn is Nothing)) Then Exit Sub
  218.     conn.Open()
  219.  
  220.     On Error Resume Next
  221.     Dim strTableName
  222.     strTableName = PromptTableName(conn)
  223.     If Err.Number <> 0 Then Exit Sub
  224.     
  225.     On Error Goto 0
  226.     DoImport conn, strTableName
  227. End Sub
  228.  
  229. Sub OnBtnImportAccessClick()
  230.      cDialog.Filter = "MS Access database files (*.mdb)|*.mdb"
  231.     cDialog.FileName = ""
  232.     cDialog.CancelError = True
  233.     Dim strTableName
  234.     strTableName = ""
  235.  
  236.     On Error Resume Next
  237.     cDialog.ShowOpen()
  238.     If Err.Number <> 0 Then Exit Sub
  239.     Dim dbFileName
  240.     dbFileName = cDialog.FileName
  241.  
  242.     Dim conn
  243.     Set conn = CreateObject("ADODB.Connection")
  244.     conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFileName)
  245.  
  246.     strTableName = PromptTableName(conn)
  247.     If Err.Number <> 0 Then Exit Sub
  248.     
  249.     On Error Goto 0
  250.     DoImport conn, strTableName
  251. End Sub
  252.  
  253. Sub OnBtnImportExcelClick()
  254.      cDialog.Filter = "MS Excel files (*.xls)|*.xls"
  255.      cDialog.FileName = ""
  256.     cDialog.CancelError = True
  257.     Dim strTableName
  258.     strTableName = ""
  259.     On Error Resume Next
  260.     cDialog.ShowOpen()
  261.     If Err.Number <> 0 Then Exit Sub
  262.     Dim dbFileName
  263.     dbFileName = cDialog.FileName
  264.     Dim conn
  265.     Set conn = CreateObject("ADODB.Connection")
  266.     conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFileName & _
  267.         ";Extended properties=Excel 8.0;")
  268.  
  269.     strTableName = PromptTableName(conn)
  270.     If Err.Number <> 0 Then Exit Sub
  271.  
  272.     On Error Goto 0
  273.     DoImport conn, strTableName
  274. End Sub
  275.  
  276. Function PersistRSS()
  277.     PersistRSS = False
  278.     Dim res
  279.     res = RssHeader(document.all.inpSiteTitle.value, _
  280.         document.all.inpSiteDescription.value, _
  281.         document.all.inpSiteURL.value, _
  282.         document.all.inpSiteDetails.value, _
  283.         document.all.inpSiteImageURL.value, _
  284.         document.all.inpSiteFurtherReading.value, _
  285.         document.all.inpSiteAuthorNames.value, _
  286.         document.all.inpSiteAuthorEmails.value)
  287.     If Not res Then
  288.         MsgBox("Site information is not complete.")
  289.         Exit Function
  290.     End If
  291.  
  292.     If Not IsNull(rsArticles) and Not (rsArticles.BOF and rsArticles.EOF) Then
  293.         rsArticles.MoveFirst()
  294.         While Not rsArticles.EOF
  295.             res = RssItem(rsArticles("Title"), rsArticles("Description"), rsArticles("URL"), _
  296.                 rsArticles("Date"), rsArticles("Category"), rsArticles("Keywords"), _
  297.                 rsArticles("Author"), rsArticles("Email"))
  298.             If Not res Then
  299.                 MsgBox("Error writing article: " + rs("Title"))
  300.                 Exit Function
  301.             End If
  302.  
  303.             rsArticles.MoveNext()
  304.         Wend
  305.     End If
  306.  
  307.     res = RssFooter()
  308.     If Not res Then
  309.         MsgBox("Can not write footer")
  310.         Exit Function
  311.     End If
  312.     
  313.     PersistRSS = True
  314. End Function
  315.  
  316. Sub OnBtnSaveRSSClick()
  317.     If Not PersistRSS Then Exit Sub
  318.     
  319.      cDialog.Filter = "RSS files (*.xml)|*.xml|All files (*.*)|*.*"
  320.      cDialog.FileName = ""
  321.     cDialog.CancelError = True
  322.     On Error Resume Next
  323.     cDialog.ShowOpen()
  324.     If Err.Number <> 0 Then Exit Sub
  325.  
  326.     On Error Goto 0
  327.     Dim res
  328.     res = RssPersist(cDialog.FileName)
  329.     sRSSXML = ""
  330.     If Not res Then
  331.         MsgBox("Can not save file")
  332.         Exit Sub
  333.     End If
  334. End Sub
  335.  
  336. Sub OnBtnExportADOClick()
  337.     Dim locator, conn
  338.     Set locator = CreateObject("DataLinks")
  339.     Set conn = locator.PromptNew()
  340.     If (IsEmpty(conn) or IsNull(conn) or (conn is Nothing)) Then Exit Sub
  341.     conn.Open()
  342.  
  343.     On Error Resume Next
  344.     Dim strTableName
  345.     strTableName = PromptTableName(conn)
  346.     If Err.Number <> 0 Then Exit Sub
  347.     
  348.     On Error Goto 0
  349.     DoExport conn, strTableName
  350. End Sub
  351.  
  352. Sub OnBtnExportAccessClick()
  353.      cDialog.Filter = "MS Access database files (*.mdb)|*.mdb"
  354.     cDialog.FileName = ""
  355.     cDialog.CancelError = True
  356.     Dim strTableName
  357.     strTableName = ""
  358.  
  359.     On Error Resume Next
  360.     cDialog.ShowOpen()
  361.     If Err.Number <> 0 Then Exit Sub
  362.     Dim dbFileName
  363.     dbFileName = cDialog.FileName
  364.     
  365.     Dim fso
  366.     Set fso = CreateObject("Scripting.FileSystemObject")
  367.     If Not fso.FileExists(dbFileName) Then
  368.         Dim cat
  369.         Set cat = CreateObject("ADOX.Catalog")
  370.         cat.Create("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFileName)
  371.         If Err.Number <> 0 Then
  372.             MsgBox Err.Description
  373.             Exit Sub
  374.         End If
  375.         Set cat = Nothing
  376.     End If
  377.     Set fso = Nothing
  378.     
  379.     Dim conn
  380.     Set conn = CreateObject("ADODB.Connection")
  381.     conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFileName)
  382.     If Err.Number <> 0 Then
  383.         MsgBox Err.Description
  384.         Exit Sub
  385.     End If
  386.  
  387.     On Error Resume Next
  388.     strTableName = PromptTableName(conn)
  389.     If Err.Number <> 0 Then Exit Sub
  390.  
  391.     On Error Goto 0
  392.     DoExport conn, strTableName
  393. End Sub
  394.  
  395. Sub OnBtnExportToExcelClick()
  396.      cDialog.Filter = "MS Excel files (*.xls)|*.xls"
  397.      cDialog.FileName = ""
  398.     cDialog.CancelError = True
  399.     Dim strTableName
  400.     strTableName = ""
  401.     On Error Resume Next
  402.     cDialog.ShowOpen()
  403.     If Err.Number <> 0 Then Exit Sub
  404.  
  405.     Dim dbFileName, conn
  406.     dbFileName = cDialog.FileName
  407.     Set conn = CreateObject("ADODB.Connection")
  408.     conn.Open("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbFileName & _
  409.         ";Extended properties=Excel 8.0;")
  410.     If Err.Number <> 0 Then
  411.         MsgBox Err.Description
  412.         Exit Sub
  413.     End If
  414.  
  415.     On Error Resume Next
  416.     strTableName = PromptTableName(conn)
  417.     If Err.Number <> 0 Then Exit Sub
  418.     
  419.     On Error Goto 0
  420.     DoExport conn, strTableName
  421. End Sub
  422.  
  423. Sub OnTblArticleListClick()
  424.     Dim srcElement
  425.     Set srcElement = window.event.srcElement
  426.     If srcElement.tagName <> "A" or IsNull(rsArticles) Then Exit Sub
  427.     CleanupArticle()
  428.  
  429.     Dim strBookmark
  430.     strBookmark = CStr(srcElement.id)
  431.     If Len(strBookmark) > 3 Then
  432.         strBookmark = Mid(strBookmark, 4)
  433.     Else
  434.         Exit Sub
  435.     End If
  436.     CurrentBookmark = VarAsType(strBookmark, BookmarkType)
  437.     rsArticles.Bookmark = CurrentBookmark
  438.  
  439.     On Error Resume Next
  440.     document.all.inpArticleTitle.value = CStr(rsArticles("Title"))
  441.     document.all.inpArticleDescription.value = CStr(rsArticles("Description"))
  442.     document.all.inpArticleURL.value = CStr(rsArticles("Url"))
  443.     document.all.inpArticleDate.value = CStr(rsArticles("Date"))
  444.     document.all.inpArticleCategory.value = CStr(rsArticles("Category"))
  445.     document.all.inpArticleKeywords.value = CStr(rsArticles("Keywords"))
  446.     document.all.inpArticleAuthorNames.value = CStr(rsArticles("Author"))
  447.     document.all.inpArticleAuthorEmails.value = CStr(rsArticles("Email"))
  448. End Sub
  449.  
  450. Function PromptTableName(conn)
  451.     'PromptTableName = window.prompt("Table name:", "Articles")
  452.     PromptTableName = CStr(window.showModalDialog("ChooseTable.html", conn, _
  453.         "dialogHeight: 350px; dialogWidth: 400px; center: yes; help: no; resizable: no; status: no"))
  454.     If PromptTableName = "" Then Err.Raise 5
  455. End Function
  456.  
  457. Sub FillArticleList()
  458.     Dim strArticles
  459.     strArticles = "<TABLE id=""tblArticleList"" border=""0"" width=""100%"" onclick=""OnTblArticleListClick()"">" & vbCRLF
  460.  
  461.     On Error Resume Next
  462.     rsArticles.MoveFirst()
  463.     If Err.Number <> 0 Then Exit Sub
  464.     BookmarkType = VarType(rsArticles.Bookmark)
  465.     While Not rsArticles.EOF
  466.         Dim strRow
  467.         strRow = "<TR>" & vbCRLF
  468.         'Bookmark is stored in ID attribute as "artXXX"
  469.            strRow = strRow & "<TD><A href=""#"" id=""art" & CStr(rsArticles.Bookmark) & """>" & _
  470.                rsArticles("Title") & "</A></TD>" & vbCRLF
  471.            strRow = strRow & "</TR>" & vbCRLF
  472.         strArticles = strArticles & strRow
  473.         rsArticles.MoveNext()
  474.     Wend
  475.  
  476.     strArticles = strArticles & "</TABLE>" & vbCRLF
  477.     document.all.tblArticleList.outerHTML = strArticles
  478. End Sub
  479.  
  480. Sub DoImport(conn, tblName)
  481.     On Error Resume Next
  482.     CleanupArticles()
  483.  
  484.     rsArticles = Null
  485.     Dim rs
  486.     Set rs = CreateObject("ADODB.Recordset")
  487.     rs.CursorLocation = 3 'adUseClient
  488.     rs.LockType = 4 'adLockBatchOptimistic
  489.     If Mid(UCase(tblName), 1, 7) <> "SELECT " Then
  490.         tblName = "SELECT [Title], [Description], [URL], [Date], [Category], [Keywords], " & _
  491.             "[Author], [Email] FROM [" & tblName & "] ORDER BY [Title]"
  492.     End If
  493.     rs.Open tblName, conn
  494.     If Err.Number <> 0 Then
  495.         MsgBox Err.Description
  496.         Exit Sub
  497.     End If
  498.     
  499.     'Disconnect recordset
  500.     Set rs.ActiveConnection = Nothing
  501.     Set rsArticles = rs
  502.     
  503.     FillArticleList()
  504. End Sub
  505.  
  506. Sub DoExport(conn, tblName)
  507.     On Error Resume Next
  508.     
  509.     Dim strCreateTable
  510.     strCreateTable = "CREATE TABLE [" & tblName & "] ([ID] AutoIncrement, [Title] VarChar(255), " & _
  511.         "[Description] Memo, [URL] VarChar(255), [Date] VarChar(80), [Category] VarChar(50), " & _
  512.         "[Keywords] VarChar(255), [Author] VarChar(255), [Email] VarChar(255))"
  513.     conn.Execute(strCreateTable)
  514.     If Err.Number <> 0 Then
  515.         MsgBox "Can not create table: " & tblName
  516.         Exit Sub
  517.     End If
  518.     
  519.     Dim rs
  520.     Set rs = CreateObject("ADODB.Recordset")
  521.     rs.Open "SELECT * FROM [" & tblName & "]", conn, 0, 3 'adOpenForwardOnly, adLockOptimistic
  522.     If Err.Number <> 0 Then
  523.         MsgBox Err.Description
  524.         Exit Sub
  525.     End If
  526.  
  527.     Dim i
  528.     i = 0
  529.  
  530.     rsArticles.MoveFirst()
  531.     While Not rsArticles.EOF
  532.         rs.AddNew()
  533.          rs("Title") = rsArticles("Title")
  534.          rs("Description") = rsArticles("Description")
  535.          rs("URL") = rsArticles("URL")
  536.          rs("Date") = rsArticles("Date")
  537.          rs("Category") = rsArticles("Category")
  538.          rs("Keywords") = rsArticles("Keywords")
  539.          rs("Author") = rsArticles("Author")
  540.          rs("Email") = rsArticles("Email")
  541.          rs.Update()
  542.  
  543.         rsArticles.MoveNext()
  544.         i = i + 1
  545.     Wend
  546.     
  547.     MsgBox("Imported " & CStr(i) & " articles.")
  548. End Sub
  549.  
  550. Function FindCurrentRow()
  551.     FindCurrentRow = Null
  552.     If IsNull(rsArticles) or IsNull(CurrentBookmark) Then Exit Function
  553.  
  554.     Dim tblArticles
  555.     Set tblArticles = document.all.tblArticleList
  556.     If IsEmpty(tblArticles) or IsNull(tblArticles) or (tblArticles is Nothing) Then Exit Function
  557.  
  558.     rsArticles.Bookmark = CurrentBookmark
  559.     Set FindCurrentRow = tblArticles.all.item("art" & CStr(CurrentBookmark))
  560.  
  561.     Do
  562.         If IsEmpty(FindCurrentRow) or IsNull(FindCurrentRow) or (FindCurrentRow is Nothing) or _
  563.             (FindCurrentRow.tagName = "TR") Then Exit Do
  564.         Set FindCurrentRow = FindCurrentRow.parentElement
  565.     Loop
  566.     
  567.     If IsEmpty(FindCurrentRow) or (FindCurrentRow is Nothing) Then FindCurrentRow = Null
  568. End Function
  569.  
  570. Sub OnBtnAddArticleClick()
  571.     On Error Resume Next
  572.     CleanupArticle()
  573.     If IsEmpty(rsArticles) or IsNull(rsArticles) Then
  574.         CreateRecordset()
  575.         If Err.Number <> 0 Then
  576.             MsgBox Err.Description
  577.             Exit Sub
  578.         End If
  579.     End If
  580.     
  581.     rsArticles.AddNew()
  582.     rsArticles("Title") = "<New article>"
  583.     rsArticles("Date") = Now
  584.     rsArticles.Update()
  585.     If Err.Number <> 0 Then
  586.         Err.Description
  587.         Exit Sub
  588.     End If
  589.     
  590.     CurrentBookmark = rsArticles.Bookmark
  591.     If BookmarkType = vbEmpty Then BookmarkType = VarType(CurrentBookmark)
  592.  
  593.     Dim tblArticles, row, cell, link, strLink
  594.     Set tblArticles = document.all.tblArticleList
  595.  
  596.     Set row = tblArticles.insertRow()
  597.     Set cell = row.insertCell()
  598.     Set link = document.createElement("<A href=""#"" id=""art" & CStr(rsArticles.Bookmark) & """>")
  599.     cell.appendChild(link)
  600.     link.innerText = rsArticles("Title")
  601.     
  602.     link.click()
  603. End Sub
  604.  
  605. Sub OnBtnRemoveArticleClick()
  606.     Dim CurrentRow
  607.     Set CurrentRow = FindCurrentRow
  608.     If IsNull(CurrentRow) Then Exit Sub
  609.     
  610.     On Error Resume Next
  611.     CleanupArticle()
  612.     rsArticles.Delete 1 'adAffectCurrent
  613.     If Err.Number <> 0 Then
  614.         MsgBox Err.Description
  615.         Exit Sub
  616.     End If
  617.     
  618.     Dim tblArticles
  619.     Set tblArticles = document.all.tblArticleList
  620.     tblArticles.deleteRow CurrentRow.rowIndex
  621. End Sub
  622.  
  623. Function GetValueAsStringOrNull(Value)
  624.     GetValueAsStringOrNull = CStr(Value)
  625.     If Len(Value) = 0 Then GetValueAsStringOrNull = Null
  626. End Function
  627.  
  628. Sub OnBtnUpdateArticleClick()
  629.     Dim CurrentRow
  630.     Set CurrentRow = FindCurrentRow
  631.     If IsNull(CurrentRow) Then Exit Sub
  632.     
  633.     On Error Resume Next
  634.     
  635.     rsArticles("Title").Value = GetValueAsStringOrNull(document.all.inpArticleTitle.value)
  636.     rsArticles("Description").Value = GetValueAsStringOrNull(document.all.inpArticleDescription.value)
  637.     rsArticles("Url").Value = GetValueAsStringOrNull(document.all.inpArticleURL.value)
  638.     rsArticles("Date").Value = GetValueAsStringOrNull(document.all.inpArticleDate.value)
  639.     rsArticles("Category").Value = GetValueAsStringOrNull(document.all.inpArticleCategory.value)
  640.     rsArticles("Keywords").Value = GetValueAsStringOrNull(document.all.inpArticleKeywords.value)
  641.     rsArticles("Author").Value = GetValueAsStringOrNull(document.all.inpArticleAuthorNames.value)
  642.     rsArticles("Email").Value = GetValueAsStringOrNull(document.all.inpArticleAuthorEmails.value)
  643.     rsArticles.Update()
  644.     
  645.     If Err.Number <> 0 Then
  646.         MsgBox Err.Description
  647.         Exit Sub
  648.     End If
  649.  
  650.     document.all.tblArticleList.all.item("art" & CStr(CurrentBookmark)).innerText = rsArticles("Title")
  651. End Sub
  652.  
  653. 'Pass data as Class is required becaus window.dialogArguments does not
  654. 'accept strings longer than 4096 characters
  655. Class RssData
  656.     Public Property Get RssXml
  657.         RssXml = sRSSXML
  658.     End Property
  659. End Class
  660.  
  661. Sub OnBtnPreviewClick()
  662.     If Not PersistRSS Then Exit Sub
  663.     
  664.     window.showModalDialog "Preview.html", new RssData, _
  665.         "dialogHeight: 500px; dialogWidth: 750px; center: yes; help: no; resizable: yes; status: no"
  666.     sRSSXML = ""
  667. End Sub
  668.